#!/usr/bin/perl
#
# List PCI devices that are listed in automach
#
use Counter;
use MachMess;
use Getopt::Long;

$pcifile = "./pci.ids";
if (! -r $pcifile) {
    $pcifile = "/usr/share/pci.ids";
}
GetOptions("debug" => \$DEBUG,
	   "pcifile=s" => \$pcifile,
	   );


initpcidb();

$counter = Counter::open();
$dbh = FileTable::dbhandle();

$stm = $dbh->prepare("SELECT kernel, lastmessage FROM automach
          WHERE lastmessage like '%//FILE /proc/pci%'");
$count = $stm->execute();

warn "Found $count records\n";

while (@data = $stm->fetchrow_array()) {
    $mess = MachMess->new($data[1]);
    $pcifile = $mess->file("/proc/pci");
    # suspect that this version only works for 2.6 kernels....
    for $line (split(/\n/, $pcifile)) {
	if ( $line =~
	     /^\s+Class (....): PCI device (....):(....) \(rev (\d+)\)/) {
	    $id1 = $1;
	    $id2 = $2;
	    $id3 = $3;
	    $rev = $4;
	    $id = "$id1 $id2:$id3 rev $rev";
	    ++ $idsfound{$id};
	    $DEBUG && print $id, "\n";
	    $DEBUG && print "$classdb{$id1}: $devicedb{$id2 . ':' . $id3}\n";
	}
    }
}

print "Found ", keys(%idsfound) + 0, " different devices\n";
for $id (sort {$idsfound{$b} <=> $idsfound{$a}} keys(%idsfound)) {
    print $idsfound{$id}, " ", $id, ":";
    my ($id1, $id23, $revstr, $rev) = split(/ /, $id);
    if (!$classdb{$id1}) {
	$classdb{$id1} = "**** UNKNOWN ****";
    }
    if (!$devicedb{$id23}) {
	$devicedb{$id23} = "**** UNKNOWN ****";
    }
    print $classdb{$id1}, ": ", $devicedb{$id23}, "\n";
    
}


sub initpcidb {
    open(DB, $pcifile) || die "Unable to open PCI database $pcifile\n";
    while(<DB>) {
	chomp;
	next if /^#/;
	next if /^\s*$/;
	if (/^(\S\S+)\s+/) {
	    $code1 = $1;
	    $manufacturer = $'; #'
	    $mode = "device";
	} elsif ($mode eq "device" && /^\t(\S+)\s+/) {
	    $code2 = $1;
	    $device = $'; #'
	    $devicedb{"$code1:$code2"} = "$manufacturer: $device";
	} elsif (/^\t\t(\S+)\s+/) {
	    # not sure what a subcode is and when to use it
	} elsif (/^C (\S+)\s+/) {
	    $class1 = $1;
	    $classname = $'; #'
	    $mode = "class";
	} elsif ($mode eq "class" && /^\t(\S+)\s+/) {
	    $class2 = $1;
	    $classdb{$class1 . $class2} = $'; #'
	} elsif ($mode eq "class" && /^\t\t(\S+)\s+/) {
	    # not sure what to do with the prog-if double-tab entries
	} else {
	    warn "Unparsed PCI DB line (mode $mode): $_\n";
	}
    }
}

